home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / perl / prlbkxmp.lha / ch6 / passwd < prev    next >
Text File  |  1991-01-08  |  19KB  |  806 lines
  1. #!/usr/bin/perl
  2.  
  3. # Customizable items.
  4.  
  5. $AGEWEEKS = 8;
  6. $EXPWEEKS = 12;
  7. $BADPATS = '/usr/etc/badpats';
  8. $BADWORDS = '/usr/etc/badwords';
  9.  
  10. # Make a list of dictionaries to search with &look
  11.  
  12. @words = $BADWORDS;
  13. if (-f '/usr/dict/web2') {
  14.     push(@words,'/usr/dict/web2');
  15. }
  16. push(@words,'/usr/dict/words');
  17. $fh = 'dictaa';
  18. foreach $dict (@words) {
  19.     open($fh,$dict) && push(@dicts, eval "*$fh");
  20.     $fh++;
  21. }
  22.  
  23. # Security blankets.
  24.  
  25. $ENV{'IFS'} = '' if $ENV{'IFS'};
  26. $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb';
  27. umask(022);
  28.  
  29. chdir '/etc' || die "Can't find /etc.\n";
  30. die "passwd program isn't running setuid to root\n" if $>;
  31.  
  32. @INC = $INC[$#INC - 1];         # Use only perl library.
  33. die "Perl library is writable by world!!!\n"
  34.     if $< && -W $INC[0];
  35. die "look.pl is writable by world!!!\n"
  36.     if $< && -W "$INC[0]/look.pl";
  37. require "look.pl";
  38.  
  39. # Uncustomizable items.
  40.  
  41. $| = 1;         # command buffering on STDOUT
  42.  
  43. @saltset = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '.', '/');
  44.  
  45. chop($host = `hostname`);
  46.  
  47. # Process the arguments.
  48.  
  49. $relax = shift if $ARGV[0] =~ /^-r/;
  50. $relax = 0 if $<;               # (superuser only)
  51.  
  52. if ($ARGV[0] =~ /^-a(.*)/) {
  53.     $AGE = $1;
  54.     $AGE = $AGEWEEKS + 1 if $AGE <= 0;
  55.     $AGE = $EXPWEEKS + 1 if $AGE > $EXPWEEKS;
  56.     shift;
  57. }
  58.  
  59. # Whose password are we changing, anyway?
  60.  
  61. # (We use getlogin in preference to getpwuid($<)[0] in case
  62. #  different accounts are sharing uids.)
  63.  
  64. ($me) = @ARGV;
  65. die "You can't change the password for $me.\n" if $me && $<;
  66. $me = getlogin unless $me;
  67. $me = (getpwuid($<))[0] unless $me;
  68.  
  69. # Trap these signals
  70.  
  71. $SIG{'INT'} = 'CLEANUP';
  72. $SIG{'HUP'} = 'CLEANUP';
  73. $SIG{'QUIT'} = 'CLEANUP';
  74. $SIG{'PIPE'} = 'CLEANUP';
  75. $SIG{'ALRM'} = 'CLEANUP';
  76.  
  77. # Check first before putting them through the wringer.  (We'll
  78. #   check again later.)
  79.  
  80. die "/etc/passwd file busy--try again later.\n" if -f 'ptmp';
  81.  
  82. # A check to see if they have an application form on file.
  83.  
  84. open(FORMS,"forms") || die "Can't open /etc/forms";
  85. $informs = 0;
  86. while (<FORMS>) {
  87.     chop;
  88.     if ($_ eq $me) {
  89.     $informs = 1;
  90.     last;
  91.     }
  92. }
  93. close(FORMS);
  94.  
  95. die <<"EOM" unless $informs;
  96. No application on file for $me--contact system administration.
  97. EOM
  98.  
  99. # Give them something to read so they don't get bored.
  100.  
  101. print "\nChanging password for $me.\n";
  102.  
  103. # Get passwd entry and remember all logins
  104.  
  105. $login = '';
  106. open(PASSWD,"passwd") || die "Can't open /etc/passwd";
  107. while (<PASSWD>) {
  108.     /^([^:]+)/;
  109.     if ($1 eq $me) {
  110.     ($login,$opasswd,$uid,$gid,$ogcos,$home,$shell)
  111.         = split(/:/);
  112.     die "You aren't you! ($< $uid $me $x $login)\n"
  113.         if $< && $< != $uid;      # Just being paranoid...
  114.     $salt = substr($opasswd,0,2);
  115.  
  116.     # Canonicalize name.
  117.  
  118.     $ogcos =~ s/,.*//;
  119.     $mynames = $ogcos;
  120.     $mynames =~ s/\W+/ /;
  121.     $mynames =~ s/^ //;
  122.     $mynames =~ s/ $//;
  123.     $mynames =~ s/ . / /g;
  124.     $mynames =~ s/ . / /g;
  125.     $mynames =~ s/^. //;
  126.     $mynames =~ s/ .$//;
  127.     $mynames =~ s/ /|/;
  128.     $mynames = '^$' if $mynames eq '';
  129.     }
  130.     ++$isalogin{$1} if length($1) >= 6;
  131. }
  132. close(PASSWD);
  133. die "$me isn't in the passwd file.\n" unless $login;
  134.  
  135. # Check for shadow password file.
  136.  
  137. if ($opasswd eq 'x' && -f '/etc/shadow') {
  138.     $shadowing = 1;
  139.     open(SHADOW,"shadow") || die "Can't open /etc/shadow";
  140.     while (<SHADOW>) {
  141.     /^([^:]+)/;
  142.     if ($1 eq $me) {
  143.         ($login,$opasswd) = split(/:/);
  144.         $salt = substr($opasswd,0,2);
  145.         last;
  146.     }
  147.     }
  148.     close(SHADOW);
  149. }
  150.  
  151. # Fetch old passwords (the encrypted version).
  152.  
  153. open(PASSHIST,"passhist");
  154. while (<PASSHIST>) {
  155.     /^([^:]+)/;
  156.     if ($1 eq $me) {
  157.     ($login,$opass,$when) = split(/:/);
  158.     $opass{$opass} = $when;
  159.     }
  160. }
  161. close PASSHIST;
  162.  
  163. # Build up a subroutine that does matching on bad passwords.
  164. # We'll use an eval to define the subroutine.
  165.  
  166. $foo = 'sub badpats {local($_) = @_;study;';
  167. open(BADPATS,$BADPATS);
  168. while (<BADPATS>) {
  169.     ($badpat,$maybe) = split(/[\n\t]+/);
  170.     ($response = $maybe) =~ s/'/\\'/ if $maybe;
  171.     $foo .= "return '$response' if /$badpat/;\n";
  172. }
  173. close BADPATS;
  174. $foo .= 'return 0;}';
  175. eval $foo;              # Note: this defines sub badpats
  176.  
  177. # Finally we can begin.
  178.  
  179. system 'stty', '-echo';
  180.  
  181. if ($<) {
  182.     print "Old password: ";
  183.     chop($pass0 = <STDIN>);
  184.     print "\n";
  185.  
  186.     # Note: we shouldn't use die while echo is off.
  187.  
  188.     do myexit(1) unless $pass0;
  189.     if (crypt($pass0,$salt) ne $opasswd) {
  190.     print "Sorry.\n";
  191.     do myexit(1);
  192.     }
  193. }
  194.  
  195. # Pick a password
  196.  
  197. for (;;) {
  198.     $goodenough = 0;
  199.     until ($goodenough) {
  200.     print "New password: ";
  201.     chop($pass1 = <STDIN>);
  202.     print "\n";
  203.     do myexit(1) unless $pass1;
  204.     print "(Checking for lousy passwords...)\n";
  205.     $goodenough = &goodenough($pass1);
  206.  
  207.     # If longer than 8 chars, check first 8 chars alone.
  208.  
  209.     if ($goodenough && length($pass1) > 8) {
  210.         $pass8 = substr($pass1,0,8);
  211.         print "(Rechecking first 8 characters...)\n";
  212.         unless ($goodenough = &goodenough($pass8)) {
  213.             print <<'EOM';
  214. (Note that only the first 8 characters count.)
  215. EOM
  216.         }
  217.     }
  218.     };
  219.  
  220.     print "Retype new passwd: ";
  221.     chop($pass2 = <STDIN>);
  222.     print "\n";
  223.   last if ($pass1 eq $pass2);
  224.     print "Password mismatch--try again.\n";
  225. }
  226.  
  227. system 'stty', 'echo';
  228.  
  229. # Now check again for a lock on the passwd file.
  230.  
  231. if (-f 'ptmp') {
  232.     print "Password file busy--waiting up to 60 seconds...\n";
  233.     for ($i = 60; $i > 0; --$i) {
  234.     sleep(1);
  235.     print $i,'...';
  236.     last unless -f 'ptmp';
  237.     }
  238. }
  239. die "\n/etc/passwd file busy--try again later.\n" if -f 'ptmp';
  240.  
  241. # Create the lock using link() for atomicity
  242.  
  243. open(PTMP,">ptmptmp$$")
  244.     || die "Can't create tmp passwd file.\n";
  245. close PTMP;
  246. $locked = link("ptmptmp$$",'ptmp');
  247. unlink "ptmptmp$$";
  248. $locked || die "/etc/passwd file busy--try again later.\n"
  249.  
  250. open(PASSWD,"passwd") || die "Can't open passwd file.\n";
  251. open(PTMP,">ptmp") || die "Can't copy passwd file.\n";
  252.  
  253. # Encrypt using salt that's fairly random but encodes weeks
  254. # since 1970, mod 64.
  255.  
  256. # (We perturb the week using the first two chars of $me so
  257. # that if everyone changes their password the same week we
  258. # still get more than 64 possible salts.)
  259.  
  260. $now = time;
  261. ($pert1, $pert2) = unpack("C2", $me);
  262. $week = $now / (60*60*24*7) + $pert1 + $pert2 - $AGE;
  263. $nsalt = $saltset[$week % 64] .  $saltset[$now % 64];
  264. $cryptpass = crypt($pass1,$nsalt);
  265.  
  266. # Now build new passwd file
  267.  
  268. while (<PASSWD>) {
  269.     chop;
  270.     ($login,$passwd,$uid,$gid,$gcos,$home,$shell) = split(/:/);
  271.     next if $login eq '';       # remove garbage entries
  272.  
  273.     # Disable open accounts.  Login ids beginning with + are
  274.     # NIS (aka YP) indirections and aren't a problem.
  275.  
  276.     $passwd = '*' if $passwd eq '' && $login !~ /^\+/;
  277.  
  278.     # Is this the line to change?
  279.  
  280.     if ($login eq $me) {
  281.     if ($shadowing) {
  282.         $passwd = 'x';
  283.     }
  284.     else {
  285.         $passwd = $cryptpass;
  286.     }
  287.  
  288.     # The following code implements a password aging scheme
  289.     # by substituting a different shell for aged or expired
  290.     # accounts.  Ordinarily this is done by another script
  291.     # running in the middle of the night.  Unless someone
  292.     # typed "passwd -a", this script always makes a new
  293.     # password and unexpires the account.
  294.  
  295.     if ($shell =~ /(exp|age)\.(.*)/) {
  296.         $shell = "/bin/$2";
  297.     }
  298.     if ($AGE >= $EXPWEEKS) {
  299.         if ($shell =~ m|/bin/(.*)|) {
  300.         $sh = $1;
  301.         $sh = 'csh' if $sh eq '';
  302.         $shell = "/usr/etc/exp.$sh";
  303.         }
  304.     }
  305.     elsif ($AGE >= $AGEWEEKS) {
  306.         if ($shell =~ m|/bin/(.*)|) {
  307.         $sh = $1;
  308.         $sh = 'csh' if $sh eq '';
  309.         $shell = "/usr/etc/age.$sh";
  310.         }
  311.     }
  312.     }
  313.     print PTMP "$login:$passwd:$uid:$gid:$gcos:$home:$shell\n"
  314.     || do { unlink 'ptmp'; die "Can't write ptmp: $!"; };
  315. }
  316. close PASSWD;
  317. close PTMP;
  318.  
  319. # Sanity checks.
  320.  
  321. ($dev,$ino,$omode,$nlink,$uid,$gid,$rdev,$osize)
  322.     = stat('passwd');
  323. ($dev,$ino,$nmode,$nlink,$uid,$gid,$rdev,$nsize)
  324.     = stat('ptmp');
  325. if ($nsize < $osize - 20 || $uid) {
  326.     unlink 'ptmp';
  327.     die "Can't write new passwd file! ($uid)\n";
  328. }
  329. chmod 0644, 'ptmp';
  330.  
  331. # Do shadow password file while we still have ptmp lock.
  332.  
  333. if ($shadowing) {
  334.     open(SHADOW,"shadow") || die "Can't open shadow file.\n";
  335.     umask 077;
  336.     open(STMP,">stmp") || die "Can't copy shadow file.\n";
  337.  
  338.     # Now build new shadow file.
  339.  
  340.     while (<SHADOW>) {
  341.     chop;
  342.     @fields = split(/:/);
  343.     if ($fields[0] eq $me) {
  344.         $fields[1] = $cryptpass;
  345.     }
  346.     print STMP join(':',@fields), "\n";
  347.     }
  348.     close SHADOW;
  349.     close STMP;
  350.     chmod 0600, 'shadow';       # probably unnecessary
  351.     rename('shadow','shadow.old');
  352.     chmod 0600, 'stmp';
  353.     rename('stmp','shadow');
  354. }
  355.  
  356. # Release lock by renaming ptmp.
  357.  
  358. rename('passwd','passwd.old');
  359. rename('ptmp','passwd')
  360.     || die "Couldn't install new passwd file: $!\n";
  361.  
  362. # Now remember the old password forever (in encrypted form).
  363.  
  364. $now = time;
  365. open(PASSHIST,">>passhist") || exit 1;
  366. print PASSHIST "$me:$opasswd:$now\n";
  367. close PASSHIST;
  368. exit 0;
  369.  
  370. ###############################################################
  371. #                                                             #
  372. # This subroutine is the whole reason for this program.  It   #
  373. # checks for many different kinds of bad password.  We don't  #
  374. # tell people what kind of pattern they MUST have, because    #
  375. # that would reduce the search space unnecessarily.           #
  376. #                                                             #
  377. # goodenough() returns 1 if password passes muster, else 0.   #
  378. #                                                             #
  379. ###############################################################
  380.  
  381. sub goodenough {
  382.     return 1 if $relax;         # Only root can bypass this.
  383.     $pass = shift(@_);
  384.     $mono = $pass !~ /^.+([A-Z].*[a-z]|[a-z].*[A-Z])/;
  385.     $mono = 0 if $pass =~ /[^a-zA-Z0-9 ]/;
  386.  
  387.     $now = time;
  388.     ($nsec,$nmin,$nhour,$nmday,$nmon,$nyear) = localtime($now);
  389.  
  390.     # Embedded null can spoof crypt routine.
  391.  
  392.     if ($pass =~ /\0/) {
  393.     print <<"EOM";
  394. Please don't use the null character in your password.
  395. EOM
  396.     return 0;
  397.     }
  398.  
  399.     # Same password they just had?
  400.  
  401.     if (crypt($pass,$salt) eq $opasswd) {
  402.     print <<"EOM";
  403. Please use a different password than you just had.
  404. EOM
  405.     return 0;
  406.     }
  407.  
  408.     # Too much like the old password?
  409.  
  410.     if ($pass0 && length($pass0) == length($pass)) {
  411.     $diff = 0;
  412.     for ($i = length($pass)-1; $i >= 0; --$i) {
  413.         ++$diff
  414.           if substr($pass,$i,1) ne substr($pass0,$i,1);
  415.     }
  416.     if ($diff <= 2) {
  417.         print <<"EOM";
  418. That's too close to your old password.  Please try again.
  419. EOM
  420.         return 0;
  421.     }
  422.     }
  423.  
  424.     # Too short?  Get progressively nastier.
  425.  
  426.     if (length($pass) < 6) {
  427.     print "I SAID, " if $isaid++;
  428.     print "Please use at least 6 characters.\n";
  429.     print "\nIf you persist I will log you out!\n\n"
  430.         if $isaid == 3;
  431.     print "\nI mean it!!\n\n"
  432.         if $isaid == 4;
  433.     print "\nThis is your last warning!!!\n\n"
  434.         if $isaid == 5;
  435.     if ($isaid == 6) {
  436.         print "\nGoodbye!\n\n";
  437.         seek(STDIN,-100,0);  # Induce indigestion in shell.
  438.         exit 123;
  439.     }
  440.     return 0;
  441.     }
  442.     $isaid = 0;
  443.  
  444.     # Is it in one of the dictionaries?
  445.  
  446.     if ($pass =~ /^[a-zA-Z]/) {
  447.     ($foo = $pass) =~ y/A-Z/a-z/;
  448.  
  449.     # First check the BADPATS file.
  450.  
  451.     if ($response = do badpats($foo)) {
  452.         print $response, "  Please try again.\n";
  453.         return 0;
  454.     }
  455.  
  456.     # Truncate common suffixes before searching dict.
  457.  
  458.     $shorte = '';
  459.     $short = $pass;
  460.     $even =
  461.         ($short =~ s/\d+$//)
  462.         ? " (even with a number)"
  463.         : "";
  464.     $short =~ s/s$//;
  465.     $short =~ s/ed$// && ($shorte = "${short}e");
  466.     $short =~ s/er$// && ($shorte = "${short}e");
  467.     $short =~ s/ly$//;
  468.     $short =~ s/ing$// && ($shorte = "${short}e");
  469.     ($cshort = $short) =~ y/A-Z/a-z/;
  470.  
  471.     # We'll iterate over several dictionaries.
  472.  
  473.     @tmp = @dicts;
  474.     while ($dict = shift(@tmp)) {
  475.         local(*DICT) = $dict;
  476.  
  477.         # Do the lookup (dictionary order, case folded)
  478.  
  479.         &look($dict,$short,1,1);
  480.         while (<DICT>) {
  481.         ($cline = $_) =~ y/A-Z/a-z/;
  482.         last if substr($cline,0,length($short)) ne $cshort;
  483.         chop;
  484.         ($_,$response) = split(/\t+/);
  485.         if ($pass eq $_ ||
  486.           ($pass eq substr($_,0,8)) ||
  487.           ($pass =~ /^$_$/i && $mono) ||
  488.           $shorte eq $_ ||
  489.           ($shorte =~ /^$_$/i && $mono) ||
  490.           $short eq $_ ||
  491.           ($short =~ /^$_$/i && $mono)) {
  492.             if ($response) {      # Has a snide remark.
  493.             print $response,
  494.                 "  Please try again.\n";
  495.             }
  496.  
  497.             elsif (/^[A-Z]/) {
  498.             if (/a$|ie$|yn$|een$|is$/) {
  499.                 print <<"EOM";
  500. Don't you use HER name that way!
  501. EOM
  502.             }
  503.             else {
  504.                 print <<"EOM";
  505. That name is$also too popular.  Please try again.
  506. EOM
  507.                 $also = ' also';
  508.             }
  509.             }
  510.             else {
  511.             print <<"EOM";
  512. Please avoid words in the dictionary$even.
  513. EOM
  514.             }
  515.             return 0;
  516.         }
  517.         }
  518.     }
  519.     }
  520.  
  521.     # Now check for two word-combinations.  This gets hairy.
  522.     # We look up everything that starts with the same first
  523.     # two letters as the password, and if the word matches the
  524.     # head of the password, we save the rest of the password
  525.     # in %others to be looked up later.  Passwords which have
  526.     # a single char before or after a word are special-cased.
  527.  
  528.     # We take pains to disallow things like "CamelAte",
  529.     # "CameLate" and "CamElate" but allow things like
  530.     # "CamelatE" or "CameLAte".
  531.  
  532.     # If the password is exactly 8 characters, we also have
  533.     # to disallow passwords that consist of a word plus the
  534.     # BEGINNING of another word, such as "CamelFle", which
  535.     # will warn you about "camel" and "flea".
  536.  
  537.     if ($pass =~ /^.[a-zA-Z]/) {
  538.     %others = ();
  539.     ($cpass = $pass) =~ y/A-Z/a-z/;
  540.     ($oneup) = $pass =~ /.[a-z]*([A-Z][a-z]*)$/;
  541.     $cpass =~ s/ //g;
  542.     if ($pass !~ /.+[A-Z].*[A-Z]/) {
  543.         $others{substr($cpass,1,999)}++
  544.         if $pass =~ /^..[a-z]+$/;
  545.         @tmp = @dicts;
  546.         while ($dict = shift(@tmp)) {
  547.         local(*DICT) = $dict;
  548.         $two = substr($cpass,0,2);
  549.         &look($dict,$two,1,1);
  550.         $two++;
  551.         word: while (<DICT>) {
  552.             chop;
  553.             s/\t.*//;
  554.             y/A-Z/a-z/;
  555.             last if $_ ge $two;
  556.             if (index($cpass,$_) == 0) {
  557.             $key = substr($cpass,length($_),999);
  558.             next word if $key =~ /\W/;
  559.             $others{$key}++ unless $oneup
  560.             && length($oneup) != length($key);
  561.             }
  562.         }
  563.         }
  564.  
  565.         @tmp = @dicts;
  566.         while ($dict = shift(@tmp)) {
  567.         local(*DICT) = $dict;
  568.         foreach $key (keys(%others)) {
  569.             &look($dict,$key,1,1);
  570.             $_ = <DICT>;
  571.             chop;
  572.             s/\t.*//;
  573.             if ($_ eq $key
  574.               || length($pass) == 8 && /^$key/) {
  575.             $pre = substr($cpass,0,length($cpass)
  576.                 - length($key));
  577.             if (length($pre) == 1) {
  578.                 $pre = sprintf("^%c", ord($pre)^64)
  579.                 unless $pre =~ /[ -~]/;
  580.                 print <<"EOM";
  581. One char "$pre" plus a word like "$_" is too easy to guess.
  582. EOM
  583.                 return 0;
  584.             }
  585.  
  586.             print <<"EOM";
  587. Please avoid two-word combinations like "$pre" and "$_".
  588. Suggestion: insert a random character in one of the words,
  589. or misspell one of them.
  590. EOM
  591.             return 0;
  592.             }
  593.             elsif (length($key) == 1
  594.               && $pass =~ /^.[a-z]+.$/) {
  595.             chop($pre = $cpass);
  596.             $key = sprintf("^%c", ord($key)^64)
  597.                 unless $key =~ /[ -~]/;
  598.             print <<"EOM";
  599. A word like "$pre" plus one char "$key" is too easy to guess.
  600. EOM
  601.             return 0;
  602.             }
  603.         }
  604.         }
  605.     }
  606.     }
  607.  
  608.     # Check for naughty words.   :-)
  609.  
  610.     # (Add the traditional naughty words to the list sometime
  611.     # when your mother isn't watching.  We didn't want to
  612.     # print them in a family-oriented book like this one...)
  613.  
  614.     if ($pass =~ /(ibm|dec|sun|at&t|nasa)/i) {
  615.     print qq#A common substring such as "$1" makes your# .
  616.         " password too easy to guess.\n";
  617.     return 0;
  618.     }
  619.  
  620.     # Does it look like a date?
  621.  
  622.     if ($pass =~ m!^[-\d/]*$!) {
  623.     if ($pass =~ m!^\d{3}-\d{2}-\d{4}$! ||
  624.         $pass =~ m!^\d\d\d\d\d\d\d\d\d$!) {
  625.         print <<"EOM";
  626. Please don't use a Social Security Number!
  627. EOM
  628.         return 0;
  629.     }
  630.     if ($pass =~ m!^\d*/\d*/\d*$! ||
  631.         $pass =~ m!^\d*-\d*-\d*$! ||
  632.         $pass =~ m!$nyear$!) {
  633.         print "Please don't use dates.\n";
  634.         return 0;
  635.     }
  636.     if ($pass =~ m!^\d\d\d-?\d\d\d\d$!) {
  637.         print "Please don't use a phone number.\n";
  638.         return 0;
  639.     }
  640.     if ($pass =~ m!^\d{6,7}$!) {
  641.         print "Please don't use a short number.\n";
  642.         return 0;
  643.     }
  644.     }
  645.  
  646.     if ($mo = ($pass =~ /^[ \d]*([a-zA-Z]{3,5})[ \d]*$/) &&
  647.       ($mo =~ /^(jan|feb|mar(ch)?|apr(il)?|may|june?/i ||
  648.        $mo =~|july?|aug|sept?|oct|nov|dec)$/i) ) {
  649.     print "Please don't use dates.\n";
  650.     return 0;
  651.     }
  652.  
  653.     # Login id?
  654.  
  655.     if ($pass =~ /$me/i) {
  656.     print "Please don't use your login id.\n";
  657.     return 0;
  658.     }
  659.  
  660.     # My own name?
  661.  
  662.     if ($pass =~ /$mynames/i) {
  663.     print "Please don't use part of your name.\n";
  664.     return 0;
  665.     }
  666.  
  667.     # My host name?
  668.  
  669.     if ($pass =~ /$host/i) {
  670.     print "Please don't use your host name.\n";
  671.     return 0;
  672.     }
  673.  
  674.     # License plate number?
  675.  
  676.     if ($pass =~ /^\d?[a-zA-Z][a-zA-Z][a-zA-Z]\d\d\d$/ ||
  677.     $pass =~ /^\d\d\d[a-zA-Z][a-zA-Z][a-zA-Z]$/) {
  678.     print "Please don't use a license number.\n";
  679.     return 0;
  680.     }
  681.  
  682.     # A function key?  (This pattern checks Sun-style fn keys.)
  683.  
  684.     if ($pass =~ /^\033\[\d+/) {
  685.     print "Please don't use a function key.\n";
  686.     return 0;
  687.     }
  688.  
  689.     # A sequence of closely related ASCII characters?
  690.  
  691.     @ary = unpack('C*',$pass);
  692.     $ok = 0;
  693.     for ($i = 0; $i < $#ary; ++$i) {
  694.     $diff = $ary[$i+1] - $ary[$i];
  695.     $ok = 1 if $diff > 1 || $diff < -1;
  696.     }
  697.     if (!$ok) {
  698.     print "Please don't use sequences.\n";
  699.     return 0;
  700.     }
  701.  
  702.     # A sequence of keyboard keys?
  703.  
  704.     ($foo = $pass) =~ y/A-Z/a-z/;
  705.     $foo =~ y/qwertyuiop[]asdfghjkl;'zxcvbnm,.\//a-la-ka-j/;
  706.     $foo =~ y/!@#\$%^&*()_+|~/abcdefghijklmn/;
  707.     $foo =~ y/-1234567890=\\`/kabcdefghijlmn/;
  708.     @ary = unpack('C*',$foo);
  709.     $ok = 0;
  710.     for ($i = 0; $i < $#ary; ++$i) {
  711.     $diff = $ary[$i+1] - $ary[$i];
  712.     $ok = 1 if $diff > 1 || $diff < -1;
  713.     }
  714.     if (!$ok) {
  715.     print "Please don't use consecutive keys.\n";
  716.     return 0;
  717.     }
  718.  
  719.     # Repeated patterns: ababab, abcabc, abcdabcd
  720.  
  721.     if ( $pass =~ /^(..)\1\1/
  722.       || $pass =~ /^(...)\1/
  723.       || $pass =~ /^(....)\1/ ) {
  724.     print <<"EOM";
  725. Please don't use repeated sequences of "$1".
  726. EOM
  727.     return 0;
  728.     }
  729.  
  730.     # Reversed patterns: abccba abcddcba
  731.  
  732.     if ( $pass =~ /^(.)(.)(.)\3\2\1/
  733.       || $pass =~ /^(.)(.)(.)(.)\4\3\2\1/ ) {
  734.     print <<"EOM";
  735. Please don't use palindromic sequences of "$1$2$3$4".
  736. EOM
  737.     return 0;
  738.     }
  739.  
  740.     # Some other login name?
  741.  
  742.     if ($isalogin{$pass}) {
  743.     print "Please don't use somebody's login id.\n";
  744.     return 0;
  745.     }
  746.  
  747.     # A local host name?
  748.  
  749.     if (-f "/usr/hosts/$pass") {
  750.     print "Please don't use a local host name.\n";
  751.     return 0;
  752.     }
  753.  
  754.     # Reversed login id?
  755.  
  756.     $reverse = reverse $me;
  757.     if ($pass =~ /$reverse/i) {
  758.     print <<"EOM";
  759. Please don't use your login id spelled backwards.
  760. EOM
  761.     return 0;
  762.     }
  763.  
  764.     # Previously used?
  765.  
  766.     foreach $old (keys(%opass)) {
  767.     if (crypt($pass,$old) eq $old) {
  768.         $when = $opass{$old};
  769.         $diff = $now - $when;
  770.         ($osec,$omin,$ohour,$omday,$omon,$oyear)
  771.         = localtime($when);
  772.         if ($oyear != $nyear) {
  773.         $oyear += 1900;
  774.         print "You had that password back in $oyear.";
  775.         }
  776.         elsif ($omon != $nmon) {
  777.         $omon = (January, February, March, April, May,
  778.             June, July, August, September, October,
  779.             November, December)[$omon];
  780.         print "You had that password back in $omon.";
  781.         }
  782.         elsif ($omday != $nmday) {
  783.         $omday .= (0,'st','nd','rd')[$omday%10]||'th';
  784.         print "You had that password on the $omday.";
  785.         }
  786.         else {
  787.         print "You had that password earlier today.";
  788.         }
  789.         print "  Please pick another.\n";
  790.         return 0;
  791.     }
  792.     }
  793.     1;
  794. }
  795.  
  796. sub CLEANUP {
  797.     system 'stty', 'echo';
  798.     print "\n\nAborted.\n";
  799.     exit 1;
  800. }
  801.  
  802. sub myexit {
  803.     system 'stty', 'echo';
  804.     exit shift(@_);
  805. }
  806.